(import
 (except (rnrs base)
         let-values
         map
         error
         vector-map)
 (only (guile)
       lambda* λ
       simple-format
       current-output-port)
 (fileio)
 (ice-9 pretty-print)
 (ice-9 peg)
 (ice-9 match)
 (prefix (peg-tree-utils) peg-tree:)
 ;; (ice-9 format)
 (srfi srfi-1)
 (pipeline)
 (debug)
 ;; (list-helpers)
 (array-helpers)
 (parallelism)
 ;; (math)
 ;; (logic)
 ;; receive
 (srfi srfi-8)
 (srfi srfi-9 gnu)
 ;; let-values
 (srfi srfi-11)
 ;; purely functional data structures
 (pfds sets)
 ;; (timing)
 )


(define input-filename "input")

(define-peg-pattern NUMBER body (and (? (or "-" "+")) (+ (range #\0 #\9))))
(define-peg-pattern ANYTHING-EXCEPT-NUMBER none
  (* (and (not-followed-by NUMBER) peg-any)))
(define-peg-pattern COORD all NUMBER)

(define-peg-pattern SENSOR-INFO body
  (and (and ANYTHING-EXCEPT-NUMBER COORD)
       (and ANYTHING-EXCEPT-NUMBER COORD)
       (and ANYTHING-EXCEPT-NUMBER COORD)
       (and ANYTHING-EXCEPT-NUMBER COORD)))

(define-immutable-record-type <sensor>
  (make-sensor sy sx by bx)
  sensor?
  (sy sensor-y set-sensor-y)
  (sx sensor-x set-sensor-x)
  (by sensor-beacon-y set-sensor-beacon-y)
  (bx sensor-beacon-x set-sensor-beacon-x))


(define parse-sensors
  (λ (line)
    (-> line
        (match-pattern SENSOR-INFO)
        peg:tree
        (map (λ (coord) (string->number (second coord))))
        ((λ (coords)
           (match coords
             [(sensor-x sensor-y beacon-x beacon-y)
              (make-sensor sensor-y sensor-x beacon-y beacon-x)]))))))


(define sensors
  (-> (get-lines-from-file input-filename)
      (map parse-sensors)))


(define manhattan-distance
  (λ (y1 x1 y2 x2)
    (+ (abs (- y1 y2))
       (abs (- x1 x2)))))


(define calc-blocked-segment
  (λ (sensor line-y)
    (match sensor
      [($ <sensor> sy sx by bx)
       (let ([distance-to-line (abs (- sy line-y))]
             [distance-to-beacon (manhattan-distance sy sx by bx)])
         (let ([delta-x (- distance-to-beacon distance-to-line)])
           (cond
            [(>= delta-x 0)
             (cons (- sx delta-x)
                   (+ sx delta-x))]
            [else #f])))])))


(define make-range
  (λ (start end)
    (cons start end)))


(define range-start
  (λ (range)
    (car range)))


(define range-end
  (λ (range)
    (cdr range)))


(define range+
  (λ (r1 r2)
    "Assumes, that the lower number is the first part of a
range."
    (make-range (min (range-start r1) (range-start r2))
                (max (range-end r1) (range-end r2)))))


(define ranges-less
  (λ (r1 r2)
    (or (< (range-start r1) (range-start r2))
        (< (range-end r1) (range-end r2)))))


(define count-blocked
  (λ (ranges)
    (let ([sorted-ranges (sort ranges ranges-less)])
      (let iter ([ranges° sorted-ranges]
                 [max-x (- (range-start (first sorted-ranges)) 1)]
                 [blocked-counter 0])
        (cond
         [(null? ranges°) blocked-counter]
         [else
          (let ([current-range (car ranges°)])
            (cond
             ;; Current range is completely outside of
             ;; already counted blocked, because its start
             ;; is already past the highest seen x.
             [(< max-x (range-start current-range))
              (iter (cdr ranges°)
                    (range-end current-range)
                    (+ blocked-counter
                       (+ (- (range-end current-range)
                             (range-start current-range))
                          1)))]
             ;; Start of current range is equal than the
             ;; highest seen x. This means, that the range
             ;; starts, not leaving a gap between already
             ;; counted blocked and its fields.
             [(= max-x (range-start current-range))
              (iter (cdr ranges°)
                    (range-end current-range)
                    (+ blocked-counter
                       ;; Plus 1 for length calculation of
                       ;; range. Length of range is (end -
                       ;; start + 1).
                       (+ (- (range-end current-range)
                             ;; Starting to count 1 behind
                             ;; max-x, to avoid counting it
                             ;; twice.
                             (+ (range-start current-range) 1))
                          1)))]
             ;; The start of the current range is before the
             ;; highest max-x we have seen so far. That
             ;; means there is overlap.
             [else
              (iter (cdr ranges°)
                    (max (range-end current-range) max-x)
                    (+ blocked-counter
                       ;; max-x to range-end might be
                       ;; negative, so take max with 0,
                       ;; adding 0 if the range is contained
                       ;; in previous ranges
                       (max 0
                            (+ (- (range-end current-range)
                                  ;; not counting max-x twice
                                  (+ max-x 1))
                               1))))]))])))))


(define pair-less
  (λ (p1 p2)
    (or (< (car p1) (car p2))
        (and (= (car p1) (car p2))
             (< (cdr p1) (cdr p2))))))


(define set-count
  (λ (set pred)
    (set-fold (λ (elem acc)
                (cond
                 [(pred elem) (+ acc 1)]
                 [else acc]))
              0
              set)))


(define count-beacons-on-line
  (λ (sensors line-y)
    (set-count (list->set (map (λ (sen)
                                 (cons (sensor-beacon-y sen)
                                       (sensor-beacon-x sen)))
                               sensors)
                          pair-less)
               (λ (beacon-pos) (= (car beacon-pos) line-y)))))


(define line-y 2000000)
(define identity (λ (x) x))


(-> sensors
    (map (λ (sensor) (calc-blocked-segment sensor line-y)))
    (filter identity)
    count-blocked
    pretty-peek
    ((λ (blocked)
       (- blocked
          (pretty-peek (count-beacons-on-line sensors line-y))))))
